home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib04.dsk / APPLE PAINTBOX (ORIGINAL).bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  165 lines
  1. 4  PRINT ""
  2. 10  GOTO 2000
  3. 15 SW$ = "OFF":ML =  PEEK(115):MH =  PEEK(116): HIMEM: 8192
  4. 20 COL = 0:COL$ = "BLACK     "
  5. 25 PIC$ = "PICTURE NOT NAMED        "
  6. 30 KBD =  -16384:SB =  -16368:B1 =  -16287:B2 =  -16286:T = 3:K = 1.18
  7. 35 P2 = 6.28318531:S = .03498066585: DIM H(4),V(4):D$ =  CHR$(4)
  8. 40 XO = 5:YO = 5:COL = 0:COL$ = "BLACK     ":PIC$ = "PICTURE NOT NAMED        "
  9. 45  HGR : GOTO 1000
  10. 50  REM  BASIC DRAW LOOP
  11. 55  IF  PEEK(KBD) = 155  THEN  POKE SB,0: GOTO 1000
  12. 60 X2 = X1:Y2 = Y1
  13. 65 X1 =  INT( PDL(0) *277/255 +1):Y1 =  INT( PDL(1) *189/255 +1)
  14. 70  IF SW  THEN  GOSUB 150: GOTO 50
  15. 75  IF  PEEK(B1) < = 127  THEN 90
  16. 80 XO = X1 +1:YO = Y1 +1: HCOLOR= 3: HPLOT XO,YO: GOSUB 175
  17. 85  FOR D = 1 TO 500: NEXT 
  18. 90  HCOLOR= 3: HPLOT X<CTRL-I>1,Y1
  19. 95  HCOLOR= 0: HPLOT X2,Y2
  20. 100  IF  PEEK(B2) >127  THEN  GOSUB 150
  21. 105  GOTO 50
  22. 150  REM  PLOT AND UPDATE
  23. 155 X3 = X1:Y3 = Y1
  24. 160  HCOLOR= COL
  25. 165  HPLOT XO,YO TO X3,Y3: HPLOT XO -1,YO TO X3 -1,Y3
  26. 170 XO = X3:YO = Y3
  27. 175  REM  ENTER HERE TO UPDATE ONLY
  28. 180 H(0) = XO:V(0) = YO
  29. 185  FOR I = 4 TO 1  STEP  -1:H(I) = H(I -1):V(I) = V(I -1): NEXT 
  30. 190  RETURN 
  31. 200  REM  SELECT COLOR
  32. 205  HOME 
  33. 210  PRINT "COLOR: B(LACK, L(IGHT BLUE, W(HITE,": PRINT "       O(RANGE, P(URPLE, G(REEN"
  34. 215  GET CH$
  35. 220  IF CH$ = "B"  THEN COL$ = "BLACK     ":COL = 0: GOTO 1000
  36. 225  IF CH$ = "L"  THEN COL$ = "LIGHT BLUE":COL = 6: GOTO 1000
  37. 230  IF CH$ = "W"  THEN COL$ = "WHITE     ":COL = 3: GOTO 1000
  38. 235  IF CH$ = "O"  THEN COL$ = "ORANGE    ":COL = 5: GOTO 1000
  39. 240  IF CH$ = "P"  THEN COL$ = "PURPLE    ":COL = 2: GOTO 1000
  40. 245  IF CH$ = "G"  THEN COL$ = "GREEN     ":COL = 1: GOTO 1000
  41. 250  GOTO 205
  42. 300  REM  TURN PEN ON AND OFF
  43. 305 SW =   NOT SW
  44. 310  IF   NOT SW  THEN SW$ = "OFF"
  45. 315  IF SW  THEN SW$ = "ON"
  46. 320  GOTO 1000
  47. 400  REM  CHANGE PICTURES
  48. 404  HOME 
  49. 408  PRINT "PICTURES: N(AME, L(OAD, S(AVE,": PRINT "          E(RASE, <ESC>"
  50. 412  ONERR  GOTO 484
  51. 416  GET CH$
  52. 420  IF CH$ =  CHR$(27)  THEN  POKE 216,0: GOTO 1000
  53. 424  IF CH$ = "E"  THEN  HOME : PRINT "ARE YOU SURE? ";: GET CH$: IF CH$ = "Y"  THEN PIC$ = "PICTURE NOT NAMED        ": HGR : POKE 216,0: GOTO 1000
  54. 428  IF CH$ = "N"  THEN 460
  55. 432  IF CH$ = "S"  THEN 476
  56. 436  IF CH$ < >"L"  THEN  POKE 216,0: GOTO 404
  57. 440  HOME : PRINT "NAME OF PICTURE TO LOAD:"
  58. 444  INPUT "",PIC$: IF  LEN(PIC$) >25  THEN PIC$ =  LEFT$(PIC$,25)
  59. 448  IF  LEN(PIC$) <25  THEN PIC$ = PIC$ +" ": GOTO 448
  60. 452  PRINT D$;"BLOAD PBX.";PIC$;",A$2000"
  61. 456  POKE 216,0: GOTO 1000
  62. 460  HOME : PRINT "NAME THIS PICTURE:"
  63. 464  INPUT "";PIC$: IF  LEN(PIC$) >25  THEN PIC$ =  LEFT$(PIC$,25)
  64. 468  IF  LEN(PIC$) <25  THEN PIC$ = PIC$ +" ": GOTO 468
  65. 472  POKE 216,0: GOTO 404
  66. 476  PRINT : PRINT D$;"BSAVE PBX.";PIC$;",A$2000,L$1FF8"
  67. 480  POKE 216,0: GOTO 1000
  68. 484  REM  LOAD/SAVE ERRORS
  69. 488 EC =  PEEK(222): IF EC = 6  THEN  PRINT "NOT ON THIS DISK": FOR D = 1 TO 1500: NEXT : POKE 216,0: GOTO 404
  70. 492  IF EC = 9  THEN  PRINT D$;"DELETE PBX.";PIC$: PRINT "THIS DISK IS FULL": FOR D = 1 TO 1500: NEXT : POKE 216,0: GOTO 404
  71. 496  PRINT "ERROR ENCOUNTERED. CHECK DISK, DRIVE,   SYNTAX, AND TRY AGAIN.": FOR D = 1 TO 2500: NEXT : POKE 216,0: GOTO 404
  72. 500  REM  SPECIAL EFFECTS
  73. 505  HOME 
  74. 510  PRINT "SPECIAL EFFECTS: F(ILL, C(URVES, <ESC>"
  75. 515  GET CH$
  76. 520  IF CH$ =  CHR$(27)  THEN 1000
  77. 525  IF CH$ = "F"  THEN 700
  78. 530  IF CH$ < >"C"  THEN 505
  79. 535 Z =  ABS(V(2) -V(1))
  80. 540  HOME : INPUT "ENTER NUMBER FOR 'A' AND <RETURN>: ";A
  81. 545  INPUT "ENTER NUMBER FOR 'B' AND <RETURN>: ";B
  82. 550  PRINT "MODULATE THIS CURVE? ";: GET CH$: PRINT : IF CH$ < >"Y"  THEN M = 0:N = 0: GOTO 565
  83. 555  INPUT "ENTER % AMPLITUDE AND <RETURN>: ";M:M = M/100 *Z
  84. 560  INPUT "ENTER FREQUENCY AND <RETURN>: ";N
  85. 565  HCOLOR= COL
  86. 570  FOR TH = 0 TO P2  STEP S
  87. 575 R = Z * SIN(TH *T)
  88. 580 X2 = K *R * COS(A *TH) +H(2)
  89. 585 X2 =  ABS(X2 +(K *M * COS(N *TH *T)))
  90. 590 Y2 = R * SIN(B *TH) +V(2)
  91. 595 Y2 =  ABS(Y2 +(M * SIN(N *TH *T)))
  92. 600  IF TH = 0  THEN X1 = X2:Y1 = Y2
  93. 605  IF X1 >278  THEN X1 = 278 -(X1 -278)
  94. 610  IF Y1 >190  THEN Y1 = 190 -(Y1 -190)
  95. 615  IF X2 >278  THEN X2 = 278 -(X2 -278)
  96. 620  IF Y2 >190  THEN Y2 = 190 -(Y2 -190)
  97. 625  HPLOT X1,Y1 TO X2,Y2
  98. 630  HPLOT X1 +1,Y1 TO X2 +1,Y2
  99. 635 X1 = X2:Y1 = Y2
  100. 640  IF  PEEK(B2) >127  THEN 1000
  101. 645  NEXT TH
  102. 650  GOTO 1000
  103. 700  REM  FILL
  104. 705 A = V(2) -V(4): IF A = 0  THEN A = 1E -6
  105. 710 B = V(1) -V(3): IF B = 0  THEN B = 1E -6
  106. 715 C = H(2) -H(4): IF C = 0  THEN C = 1E -6
  107. 720 D = H(1) -H(3): IF D = 0  THEN D = 1E -6
  108. 725  HCOLOR= COL
  109. 730  FOR N = 0 TO A
  110. 735 X9 = H(4) +N *C/A
  111. 740  IF X9 <0  THEN X9 = 0
  112. 745  IF X9 >279  THEN X9 = 279
  113. 750 Y9 = V(4) +N
  114. 755  IF Y9 <0  THEN Y9 = 0
  115. 760  IF Y9 >191  THEN Y9 = 191
  116. 765 X8 = H(3) +N *D/B
  117. 770  IF X8 <0  THEN X8 = 0
  118. 775  IF X8 >279  THEN X8 = 279
  119. 780 Y8 = V(3) +N *B/A
  120. 785  IF Y8 <0  THEN Y8 = 0
  121. 790  IF Y8 >191  THEN Y8 = 191
  122. 795  HPLOT X9,Y9 TO X8,Y8
  123. 800  IF  PEEK(B2) >127  THEN 1000
  124. 805  NEXT N
  125. 810  GOTO 1000
  126. 1000  REM  NEW PAINTBOX MENU
  127. 1005 F = 1
  128. 1010  POKE  -16304,0: POKE  -16297,0: POKE  -16301,0: POKE 34,20: HOME 
  129. 1015  IF F = 1  THEN  INVERSE 
  130. 1020  HTAB 3: PRINT "COLOR: ";COL$;"                 ": NORMAL 
  131. 1025  IF F = 2  THEN  INVERSE 
  132. 1030  HTAB 3: PRINT "PEN: ";SW$;"                          ": NORMAL 
  133. 1035  IF F = 3  THEN  INVERSE 
  134. 1040  HTAB 3: PRINT "PICTURE: ";PIC$: NORMAL 
  135. 1045  IF F = 4  THEN  INVERSE 
  136. 1050  HTAB 3: PRINT "SPECIAL EFFECTS        (Q TO QUIT) ";: NORMAL 
  137. 1055  GET CH$
  138. 1060  IF CH$ =  CHR$(21)  THEN F = F +1: IF F >4  THEN F = F -4
  139. 1065  IF CH$ =  CHR$(8)  THEN F = F -1: IF F <1  THEN F = F +4
  140. 1070  IF CH$ =  CHR$(13)  THEN  ON F GOTO 200,300,400,500
  141. 1075  IF CH$ =  CHR$(27)  THEN  POKE  -16302,0: GOTO 50
  142. 1080  IF CH$ = "Q"  THEN  POKE 115,ML: POKE 116,MH: POKE 34,0: TEXT : POKE  -16298,0: HOME : END 
  143. 1085  GOTO 1010
  144. 2000  REM  TITLE & INSTRUCTIONS
  145. 2005  HOME 
  146. 2010  VTAB 11: HTAB 13: INVERSE : PRINT "---PAINTBOX---": NORMAL 
  147. 2015  PRINT : HTAB 8: PRINT "COPYRIGHT 1980 BY AL EVANS"
  148. 2025  VTAB 24: HTAB 16: PRINT "INSTRUCTIONS?";: GET CH$: IF CH$ = "Y"  THEN 2100
  149. 2030  CLEAR : GOTO 15
  150. 2100  REM  GET INSTRUCTIONS FROM DISK
  151. 2105 LC = 0:I$ = "":D$ =  CHR$(4): HOME 
  152. 2110  ONERR  GOTO 2200
  153. 2115  PRINT : PRINT D$;"OPEN PAINTBOX INSTRUCTIONS"
  154. 2120  PRINT : PRINT D$;"READ PAINTBOX INSTRUCTIONS"
  155. 2125  GET CH$: IF CH$ < > CHR$(13)  THEN I$ = I$ +CH$: GOTO 2125
  156. 2130  PRINT : PRINT I$:I$ = "":LC = LC +1: IF LC <22  THEN 2125
  157. 2135  PRINT : PRINT D$: HTAB 11: INVERSE : PRINT "<RETURN> FOR MORE";: NORMAL 
  158. 2140  GET CH$: IF CH$ < > CHR$(13)  THEN 2140
  159. 2145 LC = 0: GOTO 2120
  160. 2200  PRINT : VTAB 24: HTAB 15: PRINT "**THE END**"
  161. 2205  PRINT "PRESS 'A' TO SEE INSTRUCTIONS AGAIN"
  162. 2210  PRINT "PRESS <RETURN> TO START PAINTING "
  163. 2215  PRINT D$;"CLOSE PAINTBOX INSTRUCTIONS"
  164. 2220  GET CH$: IF CH$ = "A"  THEN 2100
  165. 2225  POKE 216,0: CLEAR : GOTO 15